home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / infoplus.zip / PAGE_01.INC < prev    next >
Text File  |  1990-06-25  |  5KB  |  223 lines
  1. procedure page_01;
  2.  
  3. const
  4.   BIOScseg = $C000;
  5.   BIOSext = $AA55;
  6.   PCROMseg = $F000;
  7.  
  8. var
  9.   xbool : boolean;
  10.   xbyte : byte;
  11.   xchar : char;
  12.   xlong : longint;
  13.   xword1 : word;
  14.   xword2 : word;
  15.  
  16. function BIOSscan(a, b, c : word; var d : word) : boolean;
  17.  
  18. const
  19.   max = 3;
  20.   notice : array[1..max] of string = ('(C)', 'COPR.', 'COPYRIGHT');
  21.  
  22. var
  23.   i : 1..max;
  24.   len : byte;
  25.   target : string;
  26.   xbool : boolean;
  27.   xlong : longint;
  28.   xword : word;
  29.  
  30. function scan(a : string; b, c, d : word; var e : word) : boolean;
  31.  
  32. var
  33.   i : longint;
  34.   j : byte;
  35.   len : byte;
  36.   xbool1 : boolean;
  37.   xbool2 : boolean;
  38.  
  39. begin
  40.   i:=c;
  41.   len:=length(a);
  42.   xbool1:=false;
  43.   repeat
  44.     if i <= longint(d) - len + 1 then begin
  45.       j:=0;
  46.       xbool2:=false;
  47.       repeat
  48.         if j < len then
  49.           if upcase(chr(mem[b : i + j])) = a[j + 1] then
  50.             inc(j)
  51.           else begin
  52.             xbool2:=true;
  53.             inc(i)
  54.           end
  55.         else begin
  56.           xbool2:=true;
  57.           xbool1:=true;
  58.           e:=i;
  59.           scan:=true
  60.         end
  61.       until xbool2
  62.     end else begin
  63.       xbool1:=true;
  64.       scan:=false
  65.     end
  66.   until xbool1
  67. end;
  68.  
  69. begin (* function BIOSscan *)
  70.   xlong:=c;
  71.   xbool:=false;
  72.   for i:=1 to max do begin
  73.     target:=notice[i];
  74.     len:=length(target);
  75.     if xbool then
  76.       xlong:=longint(xword) - 2 + len;
  77.     if (xlong >= b) and (xlong <= c) and (scan(target, a, b, xlong, xword))
  78.       then
  79.       xbool:=true
  80.   end;
  81.   if xbool then begin
  82.     while (xword > b) and (chr(mem[a : xword - 1]) in pchar) do
  83.       dec(xword);
  84.     d:=xword
  85.   end;
  86.   BIOSscan:=xbool
  87. end;
  88.  
  89. procedure showBIOS(a, b : word);
  90.  
  91. var
  92.   xbool : boolean;
  93.   xchar : char;
  94.  
  95. begin
  96.   xbool:=false;
  97.   repeat
  98.     xchar:=chr(mem[a : b]);
  99.     if xchar in pchar then begin
  100.       write(xchar);
  101.       if b < $FFFF then
  102.         inc(b)
  103.       else
  104.         xbool:=true
  105.     end else
  106.       xbool:=true
  107.   until xbool;
  108.   writeln
  109. end;
  110.  
  111. begin (* procedure page_01 *)
  112.   caption2('Machine type');
  113.   with regs do begin
  114.     AH:=$C0;
  115.     intr($15, regs);
  116.     if nocarry then begin
  117.       xword1:=memw[ES : BX + 2];
  118.       if (xword1 = $00FC) or (xword1 = $01FC) then
  119.         writeln('PC-AT 3x9')
  120.       else if (xword1 = $00FB) or (xword1 = $01FB) then
  121.         writeln('PC-XT/2')
  122.       else if xword1 = $02FC then
  123.         writeln('PC-XT/286')
  124.       else if xword1 = $00F9 then
  125.         writeln('PC-Convertible')
  126.       else if xword1 = $00FA then
  127.         writeln('PS/2 Model 30')
  128.       else if xword1 = $04FC then
  129.         writeln('PS/2 Model 50')
  130.       else if xword1 = $05FC then
  131.         writeln('PS/2 Model 60')
  132.       else if (xword1 = $04F8) or (xword1 = $09F8) then
  133.         writeln('PS/2 Model 70')
  134.       else if (xword1 = $00F8) or (xword1 = $01F8) then
  135.         writeln('PS/2 Model 80')
  136.       else if xword1 = $06FC then
  137.         writeln('7552 Gearbox')
  138.       else
  139.         unknown('machine - model/type word', xword1, 4);
  140.       caption3('BIOS revision level');
  141.       writeln(mem[ES : BX + 4]);
  142.       xbyte:=mem[ES : BX + 5];
  143.       caption3('DMA channel 3 used');
  144.       yesorno(xbyte and $80 = $80);
  145.       caption3('Slave 8259 present');
  146.       yesorno(xbyte and $40 = $40);
  147.       caption3('Real-time clock');
  148.       yesorno(xbyte and $20 = $20);
  149.       caption3('Keyboard intercept available');
  150.       yesorno(xbyte and $10 = $10);
  151.       caption3('Wait for external event available');
  152.       yesorno(xbyte and $08 = $08);
  153.       caption3('Extended BIOS data area segment');
  154.       if xbyte and $04 = $04 then begin
  155.         AH:=$C1;
  156.         intr($15, regs);
  157.         if nocarry then
  158.           writeln(hex(ES, 4))
  159.         else
  160.           dontknow
  161.       end else
  162.         writeln('(none)');
  163.       caption3('Micro Channel');
  164.       yesorno(xbyte and $02 = $02)
  165.     end else begin
  166.       xbyte:=mem[$FFFF : $000E];
  167.       case xbyte of
  168.         $FF : writeln('PC');
  169.         $FE : writeln('PC-XT');
  170.         $FD : writeln('PCjr');
  171.         $FC : writeln('PC-AT')
  172.         else
  173.           unknown('machine - model byte', xbyte, 2)
  174.       end
  175.     end
  176.   end;
  177. (*  Byte 12:12 p. 174  *)
  178.   caption2('BIOS source');
  179.   if BIOSscan(PCROMseg, $C000, $FFFF, xword1) then
  180.     showBIOS(PCROMseg, xword1)
  181.   else
  182.     dontknow;
  183.   caption2('BIOS date');
  184.   i:=$0005;
  185.   xbool:=false;
  186.   xchar:=chr(mem[$FFFF : i]);
  187.   while (i < $0010) and (xchar in pchar) do begin
  188.     xbool:=true;
  189.     write(xchar);
  190.     inc(i);
  191.     xchar:=chr(mem[$FFFF : i])
  192.   end;
  193.   if xbool then
  194.     writeln
  195.   else
  196.     dontknow;
  197.   caption2('BIOS extensions');
  198.   xword1:=BIOScseg;
  199.   xbool:=false;
  200.   for i:=0 to 23 do begin
  201.     if (memw[xword1 : 0] = BIOSext) then begin
  202.       if not xbool then begin
  203.         writeln;
  204.         window(3, wherey + hi(windmin), twidth, tlength - 2);
  205.         caption1('Segment   Copyright notice');
  206.         writeln;
  207.         xbool:=true
  208.       end;
  209.       pause2;
  210.       if endit then
  211.         Exit;
  212.       write(hex(xword1, 4), '      ');
  213.       if BIOSscan(xword1, $0000, $1FFF, xword2) then
  214.         showBIOS(xword1, xword2)
  215.       else
  216.         dontknow
  217.     end;
  218.     inc(xword1, $0200)
  219.   end;
  220.   if not xbool then
  221.     writeln('(none)')
  222. end;
  223.